home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol058 / display.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-01-13  |  20.3 KB  |  723 lines
  1. 100  TITLE$ = "Display Program"
  2. 105  TITLE$ = TITLE$ + " ON DISPLAY"
  3. 110  VERSION$ = "Version 1.3"
  4. 115  COPY1$ = "Copyright (c) 1983, by:"
  5. 120  COPY2$ = "Melvin O. Duke"
  6. 125  PRICE$ = "$35"
  7. 130  ADDR1$ = "Melvin O. Duke"
  8. 135  ADDR2$ = "P. O. Box 20836"
  9. 140  ADDR3$ = "San Jose, CA  95160"
  10. 145  REM Dimension Statements go here
  11. 150  DIM PA.ID(800), CH.ID(800), PERS.NO(400), M.NO(400)
  12. 160  DIM PERS(15), CH(55)
  13. 170  REM Produce the first screen
  14. 175  KEY OFF : CLS
  15. 180  REM Draw the outer double box
  16. 185  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 400
  17. 190  REM Find the title location
  18. 195  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  19. 200  REM Draw the title box
  20. 205  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 600
  21. 210  REM Print the title
  22. 215  LOCATE 4,TITLE.POS : PRINT TITLE$
  23. 220  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  24. 225  REM Draw the Contribution box
  25. 230  R1 = 8 : C1 = 19 : R2 = 17 : C2 = 62 : GOSUB 400
  26. 235  REM Request the Contribution
  27. 240  LOCATE 9,23 : PRINT "If you are using these programs, and"
  28. 245  LOCATE 10,21 : PRINT "finding them of value, your contribution"
  29. 250  LOCATE 11,23 : PRINT "("+PRICE$+" suggested) will be appreciated."
  30. 255  REM Draw the Mailing Label
  31. 260  R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 600
  32. 265  REM Print the Name and Address
  33. 270  LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
  34. 275  LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
  35. 280  LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
  36. 285  REM Draw the Copyright box
  37. 290  R1 = 19 : C1 = 27 : R2 = 22 : C2 = 53 : GOSUB 400
  38. 295  REM Print the Copyright
  39. 300  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  40. 305  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  41. 310  GOTO 740
  42. 400  REM subroutine to print a double box
  43. 410  FOR I = R1 + 1 TO R2 - 1
  44. 420   LOCATE I, C1 : PRINT CHR$(186);
  45. 430   LOCATE I, C2 : PRINT CHR$(186);
  46. 440  NEXT I
  47. 450  FOR J = C1 + 1 TO C2 - 1
  48. 460   LOCATE R1, J : PRINT CHR$(205);
  49. 470   LOCATE R2, J : PRINT CHR$(205);
  50. 480  NEXT J
  51. 490   LOCATE R1, C1 : PRINT CHR$(201);
  52. 500   LOCATE R1, C2 : PRINT CHR$(187);
  53. 510   LOCATE R2, C1 : PRINT CHR$(200);
  54. 520   LOCATE R2, C2 : PRINT CHR$(188);
  55. 530  RETURN
  56. 600  REM subroutine to print a single box
  57. 610  FOR I = R1 + 1 TO R2 - 1
  58. 620   LOCATE I, C1 : PRINT CHR$(179);
  59. 630   LOCATE I, C2 : PRINT CHR$(179);
  60. 640  NEXT I
  61. 650  FOR J = C1 + 1 TO C2 - 1
  62. 660   LOCATE R1, J : PRINT CHR$(196);
  63. 670   LOCATE R2, J : PRINT CHR$(196);
  64. 680  NEXT J
  65. 690   LOCATE R1, C1 : PRINT CHR$(218);
  66. 700   LOCATE R1, C2 : PRINT CHR$(191);
  67. 710   LOCATE R2, C1 : PRINT CHR$(192);
  68. 720   LOCATE R2, C2 : PRINT CHR$(217);
  69. 730  RETURN
  70. 740  REM ask user to press a key to continue
  71. 750  LOCATE 25,1
  72. 760  PRINT "Press any key to continue";
  73. 770  K$ = INKEY$ : IF K$ = "" THEN 770
  74. 780  CLS
  75. 840  CLS
  76. 850  GOTO 2450
  77. 1000  REM Display (showgene) Program.
  78. 1010  REM By:  Melvin O. Duke.  Updated 26 June, 1983.
  79. 1020  REM Draw the form on the display
  80. 1030  R1= 1 : C1= 1 : R2=21 : C2=79: GOSUB 400 'Double box
  81. 1040  R1= 3 : C1= 1 : R2= 3 : C2=79: GOSUB 2170 'Horizontal Double
  82. 1050  LOCATE 2,3 : PRINT "Pedigree Chart for:"
  83. 1060  LOCATE 4,68 : COLOR 1 : PRINT "Birthdate:" : COLOR 7
  84. 1070  LOCATE 12, 3 : I = 1 : GOSUB 1470
  85. 1080  LOCATE  8,11 : PRINT CHR$(218)+CHR$(196);
  86. 1090  LOCATE  9,11 : PRINT CHR$(179);
  87. 1100  LOCATE 10,11 : PRINT CHR$(179);
  88. 1110  LOCATE 11,11 : PRINT CHR$(179);
  89. 1120  LOCATE  8,13 : I = 2 : GOSUB 1510
  90. 1130  LOCATE 16,11 : PRINT CHR$(192)+CHR$(196);
  91. 1140  LOCATE 13,11 : PRINT CHR$(179);
  92. 1150  LOCATE 14,11 : PRINT CHR$(179);
  93. 1160  LOCATE 15,11 : PRINT CHR$(179);
  94. 1170  LOCATE 16,13 : I = 3 : GOSUB 1510
  95. 1180  LOCATE  6,21 : PRINT CHR$(218)+CHR$(196);
  96. 1190  LOCATE  7,21 : PRINT CHR$(179);
  97. 1200  LOCATE  6,23 : I = 4 : GOSUB 1540
  98. 1210  LOCATE 10,21 : PRINT CHR$(192)+CHR$(196);
  99. 1220  LOCATE  9,21 : PRINT CHR$(179);
  100. 1230  LOCATE 10,23 : I = 5 : GOSUB 1540
  101. 1240  LOCATE 14,21 : PRINT CHR$(218)+CHR$(196);
  102. 1250  LOCATE 15,21 : PRINT CHR$(179);
  103. 1260  LOCATE 14,23 : I = 6 : GOSUB 1540
  104. 1270  LOCATE 18,21 : PRINT CHR$(192)+CHR$(196);
  105. 1280  LOCATE 17,21 : PRINT CHR$(179);
  106. 1290  LOCATE 18,23 : I = 7 : GOSUB 1540
  107. 1300  LOCATE  5,31 : PRINT CHR$(218)+CHR$(196);
  108. 1310  LOCATE  5,33 : I = 8 : GOSUB 1570
  109. 1320  LOCATE  7,31 : PRINT CHR$(192)+CHR$(196);
  110. 1330  LOCATE  7,33 : I = 9 : GOSUB 1570
  111. 1340  LOCATE  9,31 : PRINT CHR$(218)+CHR$(196);
  112. 1350  LOCATE  9,33 : I = 10 : GOSUB 1570
  113. 1360  LOCATE 11,31 : PRINT CHR$(192)+CHR$(196);
  114. 1370  LOCATE 11,33 : I = 11 : GOSUB 1570
  115. 1380  LOCATE 13,31 : PRINT CHR$(218)+CHR$(196);
  116. 1390  LOCATE 13,33 : I = 12 : GOSUB 1570
  117. 1400  LOCATE 15,31 : PRINT CHR$(192)+CHR$(196);
  118. 1410  LOCATE 15,33 : I = 13 : GOSUB 1570
  119. 1420  LOCATE 17,31 : PRINT CHR$(218)+CHR$(196);
  120. 1430  LOCATE 17,33 : I = 14 : GOSUB 1570
  121. 1440  LOCATE 19,31 : PRINT CHR$(192)+CHR$(196);
  122. 1450  LOCATE 19,33 : I = 15 : GOSUB 1570
  123. 1460  RETURN
  124. 1470  REM Routine to print the lines
  125. 1480  COLOR 0,7 : PRINT RIGHT$(STR$(I),2);
  126. 1490  COLOR 1,0 : PRINT SPACE$(62); : COLOR 7
  127. 1500  RETURN
  128. 1510  COLOR 0,7 : PRINT RIGHT$(STR$(I),2);
  129. 1520  COLOR 1,0 : PRINT SPACE$(52); : COLOR 7
  130. 1530  RETURN
  131. 1540  COLOR 0,7 : PRINT RIGHT$(STR$(I),2);
  132. 1550  COLOR 1,0 : PRINT SPACE$(42); : COLOR 7
  133. 1560  RETURN
  134. 1570  COLOR 0,7 : PRINT RIGHT$(STR$(I),2);
  135. 1580  COLOR 1,0 : PRINT SPACE$(32); : COLOR 7
  136. 1590  RETURN
  137. 1600  REM Draw the Personal Information Chart
  138. 1610  CLS
  139. 1620  R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double box
  140. 1630  R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2170  'Horizontal double
  141. 1640  LOCATE 2,3 : PRINT "Personal Information for:"
  142. 1650  R1 = 3 : C1 = 40 : R2 = 21 : C2 = 40 : GOSUB 2310  'Vertical Double
  143. 1660  LOCATE 4,3 : PRINT "Person:";
  144. 1670  LOCATE 6,3 : PRINT "Surname:";
  145. 1680  LOCATE 7,3 : PRINT "Given-names:";
  146. 1690  LOCATE 8,3 : PRINT "Sex:";
  147. 1700  R1 = 9 : C1 = 1 : R2 =11 : C2 = 40 : GOSUB 2170  'Horizontal Double
  148. 1710  LOCATE 10,3 : PRINT "Person's Father:";
  149. 1720  LOCATE 12,3 : PRINT "Surname:";
  150. 1730  LOCATE 13,3 : PRINT "Given-names:";
  151. 1740  LOCATE 14,3 : PRINT "Birth-date:";
  152. 1750  R1 = 15 : C1 = 1 : R2 = 15 : C2 = 40 : GOSUB 2240  'Horizontal Single
  153. 1760  LOCATE 16,3 : PRINT "Person's Mother:";
  154. 1770  LOCATE 18,3 : PRINT "Surname:";
  155. 1780  LOCATE 19,3 : PRINT "Given-names:";
  156. 1790  LOCATE 20,3 : PRINT "Birth-date:";
  157. 1800  LOCATE 4,42 : PRINT "Person's Vital Statistics:";
  158. 1810  LOCATE 6,42 : PRINT "Birth-date:";
  159. 1820  LOCATE 7,42 : PRINT "Birth-city:";
  160. 1830  LOCATE 8,42 : PRINT "Birth-county:";
  161. 1840  LOCATE 9,42 : PRINT "Birth-state:";
  162. 1850  LOCATE 11,42 : PRINT "Death-date:";
  163. 1860  LOCATE 12,42 : PRINT "Death-city:";
  164. 1870  LOCATE 13,42 : PRINT "Death-county:";
  165. 1880  LOCATE 14,42 : PRINT "Death-state:";
  166. 1890  LOCATE 16,42 : PRINT "Burial-date:";
  167. 1900  LOCATE 17,42 : PRINT "Burial-city:";
  168. 1910  LOCATE 18,42 : PRINT "Burial-county:";
  169. 1920  LOCATE 19,42 : PRINT "Burial-state:";
  170. 1930  RETURN
  171. 1940  REM draw a Family Group Sheet
  172. 1950  CLS
  173. 1960  R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double box
  174. 1970  R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2170  'Double Horizontal
  175. 1980  LOCATE 2,31 : PRINT "Family Group Record";
  176. 1990  LOCATE 4,3 : COLOR 1 : PRINT "Father"; : COLOR 7 : PRINT ":";
  177. 2000  LOCATE 4,56 : PRINT "Birthdate:";
  178. 2010  LOCATE 5,3 : COLOR 1 : PRINT "Mother"; : COLOR 7 : PRINT ":";
  179. 2020  LOCATE 5,56 : PRINT "Birthdate:";
  180. 2030  R1 = 6 : C1 = 1 : R2 = 6 : C2 = 79 : GOSUB 2240  'Single Horizontal
  181. 2040  LOCATE 7,3 : PRINT "Marriage Date:";
  182. 2050  LOCATE 7,35 : PRINT "Location:";
  183. 2060  R1 = 8 : C1 = 1 : R2 = 8 : C2 = 79 : GOSUB 2170  'Double Horizontal
  184. 2070  R1 = 8 : C1 = 4 : R2 = 21 : C2 = 4 : GOSUB 2380  'Single Vertical
  185. 2080  R1 = 8 : C1 = 6 : R2 = 21 : C2 = 6 : GOSUB 2380  'Single Vertical
  186. 2090  R1 = 8 : C1 = 40 : R2 = 21 : C2 = 40 : GOSUB 2380  'Single Vertical
  187. 2100  LOCATE 9,2 : COLOR 1 : PRINT "NO"; : COLOR 7
  188. 2110  LOCATE 9,5 : COLOR 1 : PRINT "S"; : COLOR 7
  189. 2120  LOCATE 9,7 : COLOR 1 : PRINT "Children:"; : COLOR 7
  190. 2130  LOCATE 9,41 : COLOR 1 : PRINT "Birthdate:"; : COLOR 7
  191. 2140  R1 = 8 : C1 = 52 : R2 = 21 : C2 = 52 : GOSUB 2380  'Single Vertical
  192. 2150  LOCATE 9,53 : COLOR 1 : PRINT "Birth Location:"; : COLOR 7
  193. 2160  RETURN
  194. 2170  REM Subroutine to draw a double horizontal line.  Attach to double.
  195. 2180  FOR J = C1 + 1 TO C2 - 1
  196. 2190   LOCATE R1,J : PRINT CHR$(205);
  197. 2200  NEXT J
  198. 2210  LOCATE R1,C1 : PRINT CHR$(204);
  199. 2220  LOCATE R1,C2 : PRINT CHR$(185);
  200. 2230  RETURN
  201. 2240  REM Subroutine to draw a single horizontal line.  Attach to double.
  202. 2250  FOR J = C1 + 1 TO C2 - 1
  203. 2260   LOCATE R1,J : PRINT CHR$(196);
  204. 2270  NEXT J
  205. 2280  LOCATE R1,C1 : PRINT CHR$(199);
  206. 2290  LOCATE R1,C2 : PRINT CHR$(182);
  207. 2300  RETURN
  208. 2310  REM Subroutine to draw a double vertical line.  Attach to double.
  209. 2320  FOR I = R1 + 1 TO R2 - 1
  210. 2330   LOCATE I,C1 : PRINT CHR$(186);
  211. 2340  NEXT I
  212. 2350  LOCATE R1,C1 : PRINT CHR$(203);
  213. 2360  LOCATE R2,C1 : PRINT CHR$(202);
  214. 2370  RETURN
  215. 2380  REM Subroutine to draw a single vertical line.  Attach to double.
  216. 2390  FOR I = R1 + 1 TO R2 - 1
  217. 2400   LOCATE I,C1 : PRINT CHR$(179);
  218. 2410  NEXT I
  219. 2420  LOCATE R1,C1 : PRINT CHR$(209);
  220. 2430  LOCATE R2,C1 : PRINT CHR$(207);
  221. 2440  RETURN
  222. 2450  REM Program begins here
  223. 2460  REM By:  Melvin O. Duke.   Updated December 1982
  224. 2470  REM Read the Parent/Child Index
  225. 2480  OPEN "a:pcindex" FOR INPUT AS #1
  226. 2490  LOCATE 4,1 : PRINT "Open the Parent/Child Index";
  227. 2500  INPUT #1, PC.COUNT
  228. 2510  FOR I = 1 TO PC.COUNT
  229. 2520  LOCATE 5,1 : PRINT "Reading Index Record #:";I;
  230. 2530   INPUT #1, PA.ID(I), CH.ID(I)
  231. 2540  NEXT I
  232. 2550  CLOSE #1
  233. 2560  REM Read the Marriage Index
  234. 2570  LOCATE 7,1 : PRINT "Open the Marriage Index";
  235. 2580  OPEN "a:mindex" FOR INPUT AS #2
  236. 2590  INPUT #2, M.COUNT
  237. 2600  FOR I = 1 TO M.COUNT
  238. 2610  LOCATE 8,1 : PRINT "Reading Marriage Index Record #:";I:
  239. 2620   INPUT #2,PERS.NO(I), M.NO(I)
  240. 2630  NEXT I
  241. 2640  CLOSE #2
  242. 2650  REM Open the Persons File
  243. 2660  LOCATE 10,1 : PRINT "Open the Persons File"
  244. 2670  OPEN "a:persfile" AS #1 LEN = 256
  245. 2680  FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  246. 2690  REM open the Marriages File
  247. 2700  LOCATE 12,1 : PRINT "Open the Marriage File"
  248. 2710  OPEN "a:marrfile" AS #2 LEN = 128
  249. 2720  FIELD 2, 5 AS M1$, 5 AS M2$, 5 AS M3$, 5 AS M4$, 11 AS M5$, 18 AS M6$, 16 AS M7$, 16 AS M8$, 45 AS M9$
  250. 2730  REM Open the Ordinance File
  251. 2740  LOCATE 14,1 : PRINT "Open the Ordinances File";
  252. 2750  OPEN "b:ordfile" AS #3 LEN = 256
  253. 2760  FIELD 3,5ASO1$,11ASO2$,11ASO3$,11ASO4$,5ASO5$,5ASO6$,11ASO7$,11ASO8$,11ASO9$,11ASO10$,11ASO11$,5ASO12$,11ASO13$,11ASO14$,11ASO15$,11ASO16$,11ASO17$,11ASO18$,11ASO19$,11ASO20$,11ASO21$,11ASO22$,11ASO23$,26ASO24$
  254. 2770  REM Obtain a Person Record from the User
  255. 2780  LOCATE 20,1 : PRINT SPACE$(79);
  256. 2790  LOCATE 20,1 : INPUT "Enter the Record-number of a Person";PERS(1)
  257. 2800  IF PERS(1) < 1 OR PERS(1) > 400 THEN CLS: GOTO 2770
  258. 2810  REM Obtain the information about a person
  259. 2820  GET #1, PERS(1)
  260. 2830  GOSUB 3300  'Extract Personal Information
  261. 2840  GOSUB 1600
  262. 2850  LOCATE 2,30 : PRINT T3$ + " " + T2$;
  263. 2860  LOCATE 6,16 : PRINT T2$;
  264. 2870  LOCATE 7,16 : PRINT T3$;
  265. 2880  LOCATE 8,16 : PRINT T4$;
  266. 2890  LOCATE 6,57 : PRINT T8$;
  267. 2900  LOCATE 7,57 : PRINT T9$;
  268. 2910  LOCATE 8,57 : PRINT T10$;
  269. 2920  LOCATE 9,57 : PRINT T11$;
  270. 2930  LOCATE 11,57 : PRINT T12$;
  271. 2940  LOCATE 12,57 : PRINT T13$;
  272. 2950  LOCATE 13,57 : PRINT T14$;
  273. 2960  LOCATE 14,57 : PRINT T15$;
  274. 2970  LOCATE 16,57 : PRINT T16$;
  275. 2980  LOCATE 17,57 : PRINT T17$;
  276. 2990  LOCATE 18,57 : PRINT T18$;
  277. 3000  LOCATE 19,57 : PRINT T19$;
  278. 3010  PERS(2) = T6
  279. 3020  PERS(3) = T7
  280. 3030  REM Check if Father is known
  281. 3040  IF PERS(2) = 0 THEN GOSUB 3590 : GOTO 3070
  282. 3050  GET #1, PERS(2)
  283. 3060  GOSUB 3300  'Extract
  284. 3070  LOCATE 12,16 : PRINT T2$;
  285. 3080  LOCATE 13,16 : PRINT T3$;
  286. 3090  LOCATE 14,16 : PRINT T8$;
  287. 3100  REM Check if Mother is known
  288. 3110  IF PERS(3) = 0 THEN GOSUB 3590 : GOTO 3140
  289. 3120  GET #1, PERS(3)
  290. 3130  GOSUB 3300  'Extract
  291. 3140  LOCATE 18,16 : PRINT T2$;
  292. 3150  LOCATE 19,16 : PRINT T3$;
  293. 3160  LOCATE 20,16 : PRINT T8$;
  294. 3170  LOCATE 23,1 : PRINT SPACE$(79);
  295. 3180  LOCATE 24,1 : PRINT SPACE$(79);
  296. 3190  LOCATE 24,1 : PRINT "(Possible Actions:  ps, pc, fg, o, p1...pn, m1...mn, q)";
  297. 3200  LOCATE 23,1 : INPUT "Next Action"; REPLY$
  298. 3210  IF REPLY$ = "ps" THEN GOSUB 6080 : GOTO 3170
  299. 3220  IF REPLY$ = "sp" THEN GOSUB 6080 : GOTO 3170
  300. 3230  IF REPLY$ = "pc" THEN 3800  'Pedigree Chart
  301. 3240  IF REPLY$ = "fg" THEN 5070  'Family Group
  302. 3250  IF REPLY$ = "o" THEN 6220  'Ordinances
  303. 3260  IF LEFT$(REPLY$,1) = "p" THEN PERS(1) = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1)) : CLS : GOTO 2800
  304. 3270  IF LEFT$(REPLY$,1) = "m" THEN 7260
  305. 3280  IF LEFT$(REPLY$,1) = "q" THEN 7390
  306. 3290  LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 3170
  307. 3300  REM Routine to Extract Personal Information
  308. 3310  T1 = CVS(F1$)
  309. 3320  T2$ = F2$
  310. 3330  FOR J = 1 TO LEN(F2$) -1
  311. 3340   IF RIGHT$(T2$,1)=" " THEN T2$ = LEFT$(T2$,LEN(T2$)-1) ELSE J = LEN(F2$)-1
  312. 3350  NEXT J
  313. 3360  T3$ = F3$
  314. 3370  FOR J = 1 TO LEN(F3$) -1
  315. 3380   IF RIGHT$(T3$,1)=" " THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
  316. 3390  NEXT J
  317. 3400  T4$ = F4$
  318. 3410  IF LEFT$(T4$,1) = "M" THEN T4$ = "Male"
  319. 3420  IF LEFT$(T4$,1) = "F" THEN T4$ = "Female"
  320. 3430  T5 = CVS(F5$)
  321. 3440  T6 = CVS(F6$)
  322. 3450  T7 = CVS(F7$)
  323. 3460  T8$ = F8$
  324. 3470  T9$ = F9$
  325. 3480  T10$ = F10$
  326. 3490  T11$ = F11$
  327. 3500  T12$ = F12$
  328. 3510  T13$ = F13$
  329. 3520  T14$ = F14$
  330. 3530  T15$ = F15$
  331. 3540  T16$ = F16$
  332. 3550  T17$ = F17$
  333. 3560  T18$ = F18$
  334. 3570  T19$ = F19$
  335. 3580  RETURN
  336. 3590  REM Blank out a Record
  337. 3600  T1 = 0
  338. 3610  T2$ = ""
  339. 3620  T3$ = ""
  340. 3630  T4$ = ""
  341. 3640  T5 = 0
  342. 3650  T6 = 0
  343. 3660  T7 = 0
  344. 3670  T8$ = ""
  345. 3680  T9$ = ""
  346. 3690  T10$ = ""
  347. 3700  T11$ = ""
  348. 3710  T12$ = ""
  349. 3720  T13$ = ""
  350. 3730  T14$ = ""
  351. 3740  T15$ = ""
  352. 3750  T16$ = ""
  353. 3760  T17$ = ""
  354. 3770  T18$ = ""
  355. 3780  T19$ = ""
  356. 3790  RETURN
  357. 3800  REM Routine to Produce a Pedigree Chart
  358. 3810  CLS
  359. 3820  GOSUB 1000 'Draw the Chart
  360. 3830  GET #1, PERS(1)
  361. 3840  GOSUB 3300  'Extract the Person
  362. 3850  LOCATE 2,23 : PRINT T3$ + " " + T2$;
  363. 3860  LOCATE 12,6 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  364. 3870  LOCATE 12,68 : PRINT T8$;
  365. 3880  PERS(2) = T6
  366. 3890  PERS(3) = T7
  367. 3900  REM Get 11
  368. 3910  IF PERS(2) = 0 THEN GOSUB 3590 : GOTO 3960
  369. 3920  GET #1, PERS(2)
  370. 3930  GOSUB 3300  'Extract
  371. 3940  LOCATE 8,16 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  372. 3950  LOCATE 8,68 : PRINT T8$;
  373. 3960  PERS(4) = T6
  374. 3970  PERS(5) = T7
  375. 3980  REM Get 10
  376. 3990  IF PERS(3) = 0 THEN GOSUB 3590 : GOTO 4040
  377. 4000  GET #1, PERS(3)
  378. 4010  GOSUB 3300  'Extract
  379. 4020  LOCATE 16,16 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  380. 4030  LOCATE 16,68 : PRINT T8$;
  381. 4040  PERS(6) = T6
  382. 4050  PERS(7) = T7
  383. 4060  REM Get 111
  384. 4070  IF PERS(4) = 0 THEN GOSUB 3590 : GOTO 4120
  385. 4080  GET #1, PERS(4)
  386. 4090  GOSUB 3300  'Extract
  387. 4100  LOCATE 6,26 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  388. 4110  LOCATE 6,68 : PRINT T8$;
  389. 4120  PERS(8) = T6
  390. 4130  PERS(9) = T7
  391. 4140  REM Get 110
  392. 4150  IF PERS(5) = 0 THEN GOSUB 3590 : GOTO 4200
  393. 4160  GET #1, PERS(5)
  394. 4170  GOSUB 3300  'Extract
  395. 4180  LOCATE 10,26 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  396. 4190  LOCATE 10,68 : PRINT T8$;
  397. 4200  PERS(10) = T6
  398. 4210  PERS(11) = T7
  399. 4220  REM Get 101
  400. 4230  IF PERS(6) = 0 THEN GOSUB 3590 : GOTO 4280
  401. 4240  GET #1, PERS(6)
  402. 4250  GOSUB 3300  'Extract
  403. 4260  LOCATE 14,26 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  404. 4270  LOCATE 14,68 : PRINT T8$;
  405. 4280  PERS(12) = T6
  406. 4290  PERS(13) = T7
  407. 4300  REM Get 100
  408. 4310  IF PERS(7) = 0 THEN GOSUB 3590 : GOTO 4360
  409. 4320  GET #1, PERS(7)
  410. 4330  GOSUB 3300  'Extract
  411. 4340  LOCATE 18,26 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  412. 4350  LOCATE 18,68 : PRINT T8$;
  413. 4360  PERS(14) = T6
  414. 4370  PERS(15) = T7
  415. 4380  REM Get 1111
  416. 4390  IF PERS(8) = 0 THEN GOSUB 3590 : GOTO 4440
  417. 4400  GET #1, PERS(8)
  418. 4410  GOSUB 3300  'Extract
  419. 4420  LOCATE  5,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  420. 4430  LOCATE  5,68 : PRINT T8$;
  421. 4440  REM
  422. 4450  REM Get 1110
  423. 4460  IF PERS(9) = 0 THEN GOSUB 3590 : GOTO 4510
  424. 4470  GET #1, PERS(9)
  425. 4480  GOSUB 3300  'Extract
  426. 4490  LOCATE  7,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  427. 4500  LOCATE  7,68 : PRINT T8$;
  428. 4510  REM
  429. 4520  REM Get 1101
  430. 4530  IF PERS(10) = 0 THEN GOSUB 3590 : GOTO 4580
  431. 4540  GET #1, PERS(10)
  432. 4550  GOSUB 3300  'Extract
  433. 4560  LOCATE  9,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  434. 4570  LOCATE  9,68 : PRINT T8$;
  435. 4580  REM
  436. 4590  REM Get 1100
  437. 4600  IF PERS(11) = 0 THEN GOSUB 3590 : GOTO 4650
  438. 4610  GET #1, PERS(11)
  439. 4620  GOSUB 3300  'Extract
  440. 4630  LOCATE 11,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  441. 4640  LOCATE 11,68 : PRINT T8$;
  442. 4650  REM
  443. 4660  REM Get 1011
  444. 4670  IF PERS(12) = 0 THEN GOSUB 3590 : GOTO 4720
  445. 4680  GET #1, PERS(12)
  446. 4690  GOSUB 3300  'Extract
  447. 4700  LOCATE 13,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  448. 4710  LOCATE 13,68 : PRINT T8$;
  449. 4720  REM
  450. 4730  REM Get 1010
  451. 4740  IF PERS(13) = 0 THEN GOSUB 3590 : GOTO 4790
  452. 4750  GET #1, PERS(13)
  453. 4760  GOSUB 3300  'Extract
  454. 4770  LOCATE 15,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  455. 4780  LOCATE 15,68 : PRINT T8$;
  456. 4790  REM
  457. 4800  REM Get 1001
  458. 4810  IF PERS(14) = 0 THEN GOSUB 3590 : GOTO 4860
  459. 4820  GET #1, PERS(14)
  460. 4830  GOSUB 3300  'Extract
  461. 4840  LOCATE 17,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  462. 4850  LOCATE 17,68 : PRINT T8$;
  463. 4860  REM
  464. 4870  REM Get 1000
  465. 4880  IF PERS(15) = 0 THEN GOSUB 3590 : GOTO 4930
  466. 4890  GET #1, PERS(15)
  467. 4900  GOSUB 3300  'Extract
  468. 4910  LOCATE 19,36 : COLOR 1 : PRINT T2$ + ", " + T3$; : COLOR 7
  469. 4920  LOCATE 19,68 : PRINT T8$;
  470. 4930  REM
  471. 4940  LOCATE 23,1 : PRINT SPACE$(79);
  472. 4950  LOCATE 24,1 : PRINT SPACE$(79);
  473. 4960  LOCATE 24,1 : PRINT "(Possible Actions:  ps, fg, pc, l1...ln, p1...pn, m1...mn, q)";
  474. 4970  LOCATE 23,1 : INPUT "Next Action"; REPLY$
  475. 4980  IF REPLY$ = "ps" THEN GOSUB 6080 : GOTO 4940
  476. 4990  IF REPLY$ = "sp" THEN GOSUB 6080 : GOTO 4940
  477. 5000  IF REPLY$ = "pc" THEN 3800
  478. 5010  IF REPLY$ = "fg" THEN 5070
  479. 5020  IF LEFT$(REPLY$,1) = "l" THEN PERS(1) = PERS(VAL(RIGHT$(REPLY$,LEN(REPLY$)-1))) : GOTO 2810
  480. 5030  IF LEFT$(REPLY$,1) = "p" THEN PERS(1) = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1)) : GOTO 2800
  481. 5040  IF LEFT$(REPLY$,1) = "m" THEN 7260
  482. 5050  IF LEFT$(REPLY$,1) = "q" THEN 7390
  483. 5060  LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 4940
  484. 5070  REM Routine to Produce a Family Group Record
  485. 5080  CLS
  486. 5090  GOSUB 1940  'Draw the form
  487. 5100  REM search the marriage index for the Person's Marriage
  488. 5110  FOUND = 0
  489. 5120  FOR L = 1 TO M.COUNT
  490. 5130   IF PERS(1) > PERS.NO(L) THEN 5190
  491. 5140   IF PERS(1) < PERS.NO(L) THEN L = M.COUNT : GOTO 5190
  492. 5150   REM found a Marriage
  493. 5160   FOUND = 1
  494. 5170   GET #2, M.NO(L)
  495. 5180   L = M.COUNT
  496. 5190  NEXT L
  497. 5200  IF FOUND = 1 THEN 5260
  498. 5210  REM No marriage found
  499. 5220  LOCATE 22,1 : PRINT "No Marriage Found";
  500. 5230  LOCATE 23,1 : PRINT "Press any key to continue";
  501. 5240  A$ = INKEY$ : IF A$ = "" THEN 5240
  502. 5250  CLS : GOTO 2810
  503. 5260  REM extract Information from the Marriage Record
  504. 5270  TT1 = CVS(M1$)
  505. 5280  TT2 = CVS(M2$)
  506. 5290  TT3 = CVS(M3$)
  507. 5300  TT4 = CVS(M4$)
  508. 5310  TT5$ = M5$
  509. 5320  TT6$ = M6$
  510. 5330  TT7$ = M7$
  511. 5340  TT8$ = M8$
  512. 5350  TT9$ = M9$
  513. 5360  REM print the Marriage Information
  514. 5370  LOCATE 7,18 : PRINT TT5$
  515. 5380  LOCATE 7,45 : PRINT TT6$
  516. 5390  REM get the Husband's Record
  517. 5400  GET #1, TT2
  518. 5410  GOSUB 3300  'Extract
  519. 5420  LOCATE 4,11 : PRINT T2$+", "+T3$;
  520. 5430  LOCATE 4,67 : PRINT T8$;
  521. 5440  REM get the Wife's Record
  522. 5450  GET #1, TT3
  523. 5460  GOSUB 3300  'Extract
  524. 5470  LOCATE 5,11 : PRINT T2$+", "+T3$;
  525. 5480  LOCATE 5,67 : PRINT T8$;
  526. 5490  REM now find the children
  527. 5500  CHILD.COUNT = 0
  528. 5510  FOR IC = 1 TO 55
  529. 5520   CH(IC) = 0
  530. 5530  NEXT IC
  531. 5540  REM search the parent/child index
  532. 5550  FOR LL = 1 TO PC.COUNT
  533. 5560   IF TT2 > PA.ID(LL) THEN 5890
  534. 5570   IF TT2 < PA.ID(LL) THEN LL = PC.COUNT : GOTO 5890
  535. 5580   REM found a child
  536. 5590   GET #1, CH.ID(LL)
  537. 5600   GOSUB 3300  'Extract
  538. 5610   REM verify that Mother is the same
  539. 5620   IF TT3 <> T7 THEN 5890
  540. 5630   REM Found a valid child
  541. 5640   CHILD.COUNT = CHILD.COUNT + 1
  542. 5650   SHOW.COUNT = CHILD.COUNT
  543. 5660   IF CHILD.COUNT = 1 THEN 5820
  544. 5670   IF CHILD.COUNT > 11 THEN SHOW.COUNT = CHILD.COUNT - 11
  545. 5680   IF CHILD.COUNT > 22 THEN SHOW.COUNT = CHILD.COUNT - 22
  546. 5690   IF CHILD.COUNT > 33 THEN SHOW.COUNT = CHILD.COUNT - 33
  547. 5700   IF CHILD.COUNT > 44 THEN SHOW.COUNT = CHILD.COUNT - 44
  548. 5710   IF (CHILD.COUNT-1) MOD 11 = 0 THEN 5720 ELSE 5820
  549. 5720   LOCATE 23,1 : PRINT SPACE$(79);
  550. 5730   LOCATE 23,1 : PRINT "Press any key to continue"
  551. 5740   A$ = INKEY$ : IF A$ = "" THEN 5740
  552. 5750   REM blank the previous children
  553. 5760   FOR ROW = 9 TO 20
  554. 5770    LOCATE ROW,2 : PRINT SPACE$(77);
  555. 5780   NEXT ROW
  556. 5790   REM restore the rest of the display
  557. 5800   GOSUB 2070
  558. 5810   LOCATE 23,1 : PRINT SPACE$(79)
  559. 5820   CH(CHILD.COUNT) = CH.ID(LL)
  560. 5830   LOCATE 9+SHOW.COUNT,2 : COLOR 0,7
  561. 5840   PRINT RIGHT$(STR$(CHILD.COUNT),2); : COLOR 7,0
  562. 5850   LOCATE 9+SHOW.COUNT,5 : PRINT LEFT$(F4$,1);  'Sex
  563. 5860   LOCATE 9+SHOW.COUNT,7 : PRINT T2$+", "+T3$;
  564. 5870   LOCATE 9+SHOW.COUNT,41 : PRINT T8$;
  565. 5880   LOCATE 9+SHOW.COUNT,53 : PRINT T9$;
  566. 5890  NEXT LL
  567. 5900  LOCATE 23,1 : PRINT SPACE$(79);
  568. 5910  LOCATE 24,1 : PRINT SPACE$(79);
  569. 5920  LOCATE 24,1 : PRINT "(Possible Actions: ps, f, m, p1...pn, c1...cn, m1...mn, q)";
  570. 5930  LOCATE 23,1 : INPUT "Next Action";REPLY$
  571. 5940  IF REPLY$ = "ps" THEN GOSUB 6080 : GOTO 5900
  572. 5950  IF REPLY$ = "sp" THEN GOSUB 6080 : GOTO 5900
  573. 5960  IF REPLY$ = "pc" THEN LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 5900
  574. 5970  IF REPLY$ = "f" THEN PERS(1) = TT2 : GOTO 2810
  575. 5980  IF REPLY$ = "m" THEN PERS(1) = TT3 : GOTO 2810
  576. 5990  IF LEFT$(REPLY$,1) = "p" THEN PERS(1) = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1)) : GOTO 2800
  577. 6000  IF LEFT$(REPLY$,1) = "c" THEN 6010 ELSE 6050
  578. 6010  CHLD = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1))
  579. 6020  IF CHLD < 1 OR CHLD > CHILD.COUNT THEN 6070
  580. 6030  PERS(1) = CH(CHLD)
  581. 6040  GOTO 2810  'for personal
  582. 6050  IF LEFT$(REPLY$,1) = "m" THEN 7260 'marriage
  583. 6060  IF LEFT$(REPLY$,1) = "q" THEN 7390
  584. 6070  LOCATE 22,1 : PRINT "Error in Previous Reply ";REPLY$; : GOTO 5900
  585. 6080  REM Routine to Print the Screen
  586. 6090  REM Accessed by users 'ps' reply
  587. 6100  FOR ROW = 1 TO 20
  588. 6110   THIS$ = SPACE$(80)
  589. 6120   FOR COL = 1 TO 80
  590. 6130    X = SCREEN(ROW,COL)
  591. 6140    IF X > 125 THEN X = 32
  592. 6150    IF X < 32 THEN X = 32
  593. 6160    MID$(THIS$,COL,1) = CHR$(X)
  594. 6170   NEXT COL
  595. 6180   LPRINT THIS$
  596. 6190  NEXT ROW
  597. 6200  LPRINT CHR$(12);
  598. 6210  RETURN
  599. 6220  REM Routine to Display the Ordinances
  600. 6230  GET #1, PERS(1) : GOSUB 3300
  601. 6240  GET #3, PERS(1)
  602. 6250  SEX$ = LEFT$(T4$,1)
  603. 6260  REM Extract the Ordinance Information
  604. 6270  U1 = CVS(O1$)
  605. 6280  U2$ = O2$
  606. 6290  U3$ = O3$
  607. 6300  U4$ = O4$
  608. 6310  U5  = CVS(O5$)
  609. 6320  U6  = CVS(O6$)
  610. 6330  U7$ = O7$
  611. 6340  U8$ = O8$
  612. 6350  U9$ = O9$
  613. 6360  U10$ = O10$
  614. 6370  U11$ = O11$
  615. 6380  U12  = CVS(O12$)
  616. 6390  U13$ = O13$
  617. 6400  U14$ = O14$
  618. 6410  U15$ = O15$
  619. 6420  U16$ = O16$
  620. 6430  U17$ = O17$
  621. 6440  U18$ = O18$
  622. 6450  U19$ = O19$
  623. 6460  U20$ = O20$
  624. 6470  U21$ = O21$
  625. 6480  U22$ = O22$
  626. 6490  U23$ = O23$
  627. 6500  U24$ = O24$
  628. 6510  CLS
  629. 6520  R1 = 1 : C1 = 1 : R2 = 21 : C2 = 79 : GOSUB 400  'Double Box
  630. 6530  R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2170  'Horizontal Double
  631. 6540  R1 = 19 : C1 = 1 : R2 = 19 : C2 = 79 : GOSUB 2170  'Horizontal Double
  632. 6550  LOCATE 2,3 : PRINT "Ordinance Information for:";
  633. 6560  LOCATE 4,7 : COLOR 1 : PRINT "Personal Record"; : COLOR 7
  634. 6570  LOCATE 5,3 : PRINT "Christening:";
  635. 6580  LOCATE 6,3 : PRINT "Blessing:";
  636. 6590  LOCATE 7,3 : PRINT "Sealed to Parents:";
  637. 6600  LOCATE 8,5 : PRINT "Father's Id:";
  638. 6610  LOCATE 9,6 : PRINT "Name:";
  639. 6620  LOCATE 10,5 : PRINT "Mother's Id:";
  640. 6630  LOCATE 11,6 : PRINT "Name:";
  641. 6640  LOCATE 12,3 : PRINT "Baptism:";
  642. 6650  LOCATE 13,3 : PRINT "Confirmation:";
  643. 6660  LOCATE 14,3 : PRINT "Patriarchical Blessing:";
  644. 6670  LOCATE 15,3 : PRINT "Endowment:";
  645. 6680  LOCATE 16,4 : PRINT "Sealed to Spouse:";
  646. 6690  LOCATE 17,5 : PRINT "Spouse's Id.:";
  647. 6700  LOCATE 18,6 : PRINT "Name:";
  648. 6710  REM Test for Male.  Skip if not
  649. 6720  IF SEX$ <> "M" THEN 6860
  650. 6730  R1 = 3 : R2 = 19 : C1 = 40 : C2 = 40 : GOSUB 2310  "Vertical Double
  651. 6740  LOCATE 4,46 : COLOR 1 : PRINT "Priesthood Record"; : COLOR 7
  652. 6750  LOCATE 5,42 : PRINT "Aaronic Priesthood:";
  653. 6760  LOCATE 6,44 : PRINT "Deacon:";
  654. 6770  LOCATE 7,44 : PRINT "Teacher:";
  655. 6780  LOCATE 8,44 : PRINT "Priest:";
  656. 6790  LOCATE 10,42 : PRINT "Melchizedek Priesthood:";
  657. 6800  LOCATE 11,44 : PRINT "Elder:";
  658. 6810  LOCATE 12,44 : PRINT "Seventy:";
  659. 6820  LOCATE 13,44 : PRINT "High Priest:";
  660. 6830  LOCATE 15,42 : PRINT "Bishop:";
  661. 6840  LOCATE 16,42 : PRINT "Patriarch:";
  662. 6850  LOCATE 17,42 : PRINT "Apostle:";
  663. 6860  LOCATE 20,3  : PRINT "Occupation:";
  664. 6870  REM Print the Information Currently Present
  665. 6880  LOCATE 2,30 : PRINT T3$ + " " + T2$;
  666. 6890  LOCATE 2,67 : PRINT T8$;
  667. 6900  LOCATE 5,28 : PRINT U2$;
  668. 6910  LOCATE 6,28 : PRINT U3$;
  669. 6920  LOCATE 7,28 : PRINT U4$;
  670. 6930  IF LEFT$(U4$,3) = "BIC" THEN U5 = T6 : U6 = T7
  671. 6940  LOCATE 8,18 : PRINT U5;
  672. 6950  IF U5 = 0 THEN 6980
  673. 6960  GET #1, U5 : GOSUB 3300  'Extract Father Information
  674. 6970  LOCATE 9,12 : PRINT T3$ + " " + T2$;
  675. 6980  LOCATE 10,18 : PRINT U6;
  676. 6990  IF U6 = 0 THEN 7020
  677. 7000  GET #1, U6 : GOSUB 3300  'Extract Mother Information
  678. 7010  LOCATE 11,12 : PRINT T3$ + " " + T2$;
  679. 7020  LOCATE 12,28 : PRINT U7$;
  680. 7030  LOCATE 13,28 : PRINT U8$;
  681. 7040  LOCATE 14,28 : PRINT U9$;
  682. 7050  LOCATE 15,28 : PRINT U10$;
  683. 7060  LOCATE 16,28 : PRINT U11$;
  684. 7070  LOCATE 17,18 : PRINT U12;
  685. 7080  IF U12 = 0 THEN 7110
  686. 7090  GET #1, U12 : GOSUB 3300  'Extract Spouse Information
  687. 7100  LOCATE 18,12 : PRINT T3$ + " " + T2$;
  688. 7110  REM Test for Male.  Bypass if not.
  689. 7120  IF SEX$ <> "M" THEN 7240
  690. 7130  LOCATE 5,67 : PRINT U13$;
  691. 7140  LOCATE 6,67 : PRINT U14$;
  692. 7150  LOCATE 7,67 : PRINT U15$;
  693. 7160  LOCATE 8,67 : PRINT U16$;
  694. 7170  LOCATE 10,67 : PRINT U17$;
  695. 7180  LOCATE 11,67 : PRINT U18$;
  696. 7190  LOCATE 12,67 : PRINT U19$;
  697. 7200  LOCATE 13,67 : PRINT U20$;
  698. 7210  LOCATE 14,67 : PRINT U21$;
  699. 7220  LOCATE 15,67 : PRINT U22$;
  700. 7230  LOCATE 16,67 : PRINT U23$;
  701. 7240  LOCATE 20,15 : PRINT U24$;
  702. 7250  GOTO 3170  'For User Action
  703. 7260  REM Marriage was requested by Number
  704. 7270  MARRIAGE = VAL(RIGHT$(REPLY$,LEN(REPLY$)-1))
  705. 7280  CLS
  706. 7290  IF MARRIAGE > 0 AND MARRIAGE <= 200 THEN 7360
  707. 7300  LOCATE 22,1 : PRINT SPACE$(79);
  708. 7310  LOCATE 22,1 : PRINT "Invalid Marriage Number";
  709. 7320  LOCATE 23,1 : PRINT SPACE$(79);
  710. 7330  LOCATE 23,1 : PRINT "Press any key to continue."
  711. 7340  A$ = INKEY$ : IF A$ = "" THEN 7340
  712. 7350  GOTO 2810
  713. 7360  GOSUB 1940  'Print the form
  714. 7370  GET #2, MARRIAGE
  715. 7380  GOTO 5260
  716. 7390  REM Wrapup
  717. 7400  CLOSE #1
  718. 7410  CLOSE #2
  719. 7420  CLOSE #3
  720. 7430  CLS : LOCATE 21,1
  721. 7440  PRINT "End of Program"
  722. 7450  END
  723.